#!/usr/bin/tclsh

set MAX 10
set WIDTH [ expr 2*$MAX+1 ]
set size 10
set FG "X"
set BG " "
set INTERVAL 75

proc move { pegs_r a b } {
    upvar $pegs_r pegs
    lappend pegs($b) [ lindex $pegs($a) end ]
    set pegs($a) [ lreplace $pegs($a) end end ]
}

set pegs(0) {}
for { set i $size } { $i > 0 } { incr i -1 } {
    set pegs(0) [ concat $pegs(0) $i ]
}
set pegs(1) {}
set pegs(2) {}

for { set tier 0 } { $tier < $MAX+1 } { incr tier } {
    set disk {}
    set st [ expr $WIDTH/2-$tier ]
    set en [ expr $WIDTH/2+$tier ]
    for { set i 0 } { $i < $WIDTH } { incr i } {
	if { $i > $st && $i < $en } {
	    append disk $FG
	} {
	    append disk $BG
	}
    }
    lappend DISKS $disk
}

proc print_pegs { pegs_r } {
    global MAX FG BG DISKS INTERVAL
    upvar $pegs_r pegs
    exec tput clear >@ stdout
    for { set tier $MAX } { $tier > -1 } { incr tier -1 } {
	set line {}
	for { set peg 0 } { $peg < 3 } { incr peg } {
	    if { [ llength $pegs($peg) ] > $tier } {
		append line [ lindex $DISKS [ lindex $pegs($peg) $tier ] ]
	    } {
		append line [ lindex $DISKS 0 ]
	    }
	}
	puts $line
    }
    after $INTERVAL
}

proc hanoi { pegs_r n f t u } {
    upvar $pegs_r pegs
    if { $n == 1 } {
	move pegs $f $t
	print_pegs pegs
    } {
	hanoi pegs [ expr $n-1 ] $f $u $t 
	hanoi pegs 1 $f $t $u 
	hanoi pegs [ expr $n-1 ] $u $t $f 
    }
}

print_pegs pegs
while { true } {
    after 1000
    hanoi pegs $size 0 1 2
    after 1000
    hanoi pegs $size 1 2 0
    after 1000
    hanoi pegs $size 2 0 1
}
